home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 076-100 / disk_077 / quest / qmain.d < prev    next >
Text File  |  1992-05-06  |  13KB  |  617 lines
  1. #include:util.g
  2. #q.g
  3.  
  4. /* a data structure we need to keep track of where we've dropped things: */
  5.  
  6. type
  7.     ContentsList_t = struct {
  8.     *ContentsList_t cl_next;
  9.     long cl_line, cl_column;
  10.     *List_t cl_contents;
  11.     };
  12.  
  13. /* codes for the types of words in a sentence: */
  14.  
  15. Id_t
  16.     VERB = 1,
  17.     ARTICLE = 2,
  18.     ADJECTIVE = 3,
  19.     NOUN = 4,
  20.     PREPOSITION = 5,
  21.     PUNCTUATION = 6,
  22.     AUXILLIARY = 7,
  23.  
  24. /* id's for some words that we need to know: */
  25.  
  26.     /* verbs: */
  27.  
  28.     NORTH = 1001,
  29.     SOUTH = 1002,
  30.     EAST = 1003,
  31.     WEST = 1004,
  32.     QUIT = 1005,
  33.     DROP = 1006,
  34.     PUT = 1007,
  35.     GET = 1008,
  36.     PICK = 1009,
  37.     LOOK = 1010,
  38.     LONG = 1011,
  39.     DUMP = 1012,
  40.  
  41.     /* articles: */
  42.  
  43.     THE = 2001,
  44.  
  45.     /* adjectives: */
  46.  
  47.     /* nouns: */
  48.  
  49.     SWORD = 4001,
  50.     BOTTLE = 4002,
  51.     KNIFE = 4003,
  52.     PURSE = 4004,
  53.     AMULET = 4005,
  54.  
  55.     /* prepositions: */
  56.  
  57.     /* punctuation: */
  58.  
  59.     PERIOD = 6001,
  60.  
  61.     /* auxilliaries: */
  62.  
  63.     DOWN = 7001,
  64.     UP = 7002,
  65.     AROUND = 7003,
  66.  
  67.     /* some properties and attributes we need: */
  68.  
  69.     CARRYABLE = 8002;        /* object can be carried */
  70.  
  71. channel output text TextOut;
  72. long PlayerLine, PlayerColumn, MoveCount;
  73. *List_t CarryList, CarryNext;
  74. *ContentsList_t Contents;
  75. *char Condition;
  76. bool Quit;
  77.  
  78. /*
  79.  * scenery - simple scenery generator.
  80.  */
  81.  
  82. proc scenery(long l, c)C2:
  83.     long l1, c1;
  84.  
  85.     l1 := |l % 30;
  86.     if l1 >= 15 then l1 := l1 - 30 fi;
  87.     c1 := |c % 30;
  88.     if c1 >= 15 then c1 := c1 - 30 fi;
  89.     if l1 * l1 + c1 * c1 <= 16 or l1 = 0 or c1 = 0 then
  90.     C2('~', '~')
  91.     elif l1 * l1 + c1 * c1 <= 25 then
  92.     C2('\#', '\#')
  93.     else
  94.     l := l * 997 + c + 10321;
  95.     l := l * l;
  96.     if l / 32 % 8 = 0 then
  97.         C2('/', '\\')
  98.     else
  99.         C2(' ', ' ')
  100.     fi
  101.     fi
  102. corp;
  103.  
  104. /*
  105.  * findCList - find the contents list for the given location.
  106.  */
  107.  
  108. proc findCList(long line, column)*ContentsList_t:
  109.     *ContentsList_t cl;
  110.  
  111.     cl := Contents;
  112.     while cl ~= nil and (cl*.cl_line ~= line or cl*.cl_column ~= column) do
  113.     cl := cl*.cl_next;
  114.     od;
  115.     cl
  116. corp;
  117.  
  118. /*
  119.  * findContents - return the actual contents of a location.
  120.  */
  121.  
  122. proc findContents(long line, column)*List_t:
  123.     *ContentsList_t cl;
  124.  
  125.     cl := findCList(line, column);
  126.     if cl = nil then
  127.     nil
  128.     else
  129.     cl*.cl_contents
  130.     fi
  131. corp;
  132.  
  133. /*
  134.  * addContents - add a contents list for the given location, if not there.
  135.  */
  136.  
  137. proc addContents(long line, column)**List_t:
  138.     *ContentsList_t cl;
  139.  
  140.     cl := findCList(line, column);
  141.     if cl = nil then
  142.     cl := new(ContentsList_t);
  143.     cl*.cl_next := Contents;
  144.     cl*.cl_line := line;
  145.     cl*.cl_column := column;
  146.     cl*.cl_contents := nil;
  147.     Contents := cl;
  148.     fi;
  149.     &cl*.cl_contents
  150. corp;
  151.  
  152. /*
  153.  * termContents - clean up all the contents stuff.
  154.  */
  155.  
  156. proc termContents()void:
  157.     *ContentsList_t cl;
  158.  
  159.     while Contents ~= nil do
  160.     cl := Contents;
  161.     Contents := cl*.cl_next;
  162.     lFree(cl*.cl_contents);
  163.     free(cl);
  164.     od;
  165. corp;
  166.  
  167. /*
  168.  * lookAround - list the objects at this location.
  169.  */
  170.  
  171. proc lookAround()bool:
  172.     *List_t il;
  173.  
  174.     il := findContents(PlayerLine, PlayerColumn);
  175.     if il ~= nil then
  176.     write(TextOut; "Nearby: ");
  177.     while il ~= nil do
  178.         write(TextOut; psGet(il*.il_this));
  179.         il := il*.il_next;
  180.         if il ~= nil then
  181.         write(TextOut; ", ");
  182.         fi;
  183.     od;
  184.     true
  185.     else
  186.     false
  187.     fi
  188. corp;
  189.  
  190. /*
  191.  * move - move our character in the given relative direction.
  192.  */
  193.  
  194. proc move(long lineDelta, columnDelta)void:
  195.     char ch;
  196.  
  197.     ch := scAt(PlayerLine + lineDelta, PlayerColumn + columnDelta)[0];
  198.     if ch = '\#' or ch = '/' or ch = 'T' then
  199.     write(TextOut; "You can't move there.");
  200.     Condition := "Dazed";
  201.     scUpdate(4);
  202.     else
  203.     PlayerLine := PlayerLine + lineDelta;
  204.     PlayerColumn := PlayerColumn + columnDelta;
  205.     scMove(0, PlayerLine, PlayerColumn);
  206.     MoveCount := MoveCount + 1;
  207.     scUpdate(3);
  208.     if Condition* ~= 'H' then
  209.         if Condition* = 'D' then
  210.         Condition := "Bruised";
  211.         else
  212.         Condition := "Healthy";
  213.         fi;
  214.         scUpdate(4);
  215.     fi;
  216.     if lookAround() then fi;
  217.     fi;
  218. corp;
  219.  
  220. /*
  221.  * gramInit - set up our dictionary and grammar.
  222.  */
  223.  
  224. proc gramInit()void:
  225.  
  226.     psWord(NORTH, "north", VERB);
  227.     psWord(SOUTH, "south", VERB);
  228.     psWord(EAST, "east", VERB);
  229.     psWord(WEST, "west", VERB);
  230.     psWord(NORTH, "n", VERB);
  231.     psWord(SOUTH, "s", VERB);
  232.     psWord(EAST, "e", VERB);
  233.     psWord(WEST, "w", VERB);
  234.     psWord(QUIT, "quit", VERB);
  235.     psWord(DROP, "drop", VERB);
  236.     psWord(PUT, "put", VERB);
  237.     psWord(GET, "get", VERB);
  238.     psWord(PICK, "pick", VERB);
  239.     psWord(LOOK, "look", VERB);
  240.     psWord(LONG, "long", VERB);
  241.     psWord(DUMP, "dump", VERB);
  242.  
  243.     psWord(THE, "the", ARTICLE);
  244.     psWord(THE, "a", ARTICLE);
  245.     psWord(THE, "an", ARTICLE);
  246.     psWord(THE, "one", ARTICLE);
  247.  
  248.     psWord(SWORD, "sword", NOUN);
  249.     psWord(BOTTLE, "bottle", NOUN);
  250.     psWord(KNIFE, "knife", NOUN);
  251.     psWord(PURSE, "purse", NOUN);
  252.     psWord(AMULET, "amulet", NOUN);
  253.  
  254.     psWord(PERIOD, ".", PUNCTUATION);
  255.     psWord(PERIOD, "!", PUNCTUATION);
  256.  
  257.     psWord(DOWN, "down", AUXILLIARY);
  258.     psWord(UP, "up", AUXILLIARY);
  259.     psWord(AROUND, "around", AUXILLIARY);
  260.  
  261.     /* rule #1 - look [around] */
  262.  
  263.     psgBegin(1);
  264.     psgWord(f_reqId, LOOK);
  265.     psgWord(f_optId, AROUND);
  266.     psgWord(f_optType, PUNCTUATION);
  267.     psgEnd();
  268.  
  269.     /* rule #2 - drop [ART] N */
  270.  
  271.     psgBegin(2);
  272.     psgWord(f_reqId, DROP);
  273.     psgWord(f_optType, ARTICLE);
  274.     psgWord(f_reqType, NOUN);
  275.     psgWord(f_optType, PUNCTUATION);
  276.     psgEnd();
  277.  
  278.     /* rule #3 - put down [ART] N */
  279.  
  280.     psgBegin(3);
  281.     psgWord(f_reqId, PUT);
  282.     psgWord(f_reqId, DOWN);
  283.     psgWord(f_optType, ARTICLE);
  284.     psgWord(f_reqType, NOUN);
  285.     psgWord(f_optType, PUNCTUATION);
  286.     psgEnd();
  287.  
  288.     /* rule #4 - put [ART] N down */
  289.  
  290.     psgBegin(4);
  291.     psgWord(f_reqId, PUT);
  292.     psgWord(f_optType, ARTICLE);
  293.     psgWord(f_reqType, NOUN);
  294.     psgWord(f_reqId, DOWN);
  295.     psgWord(f_optType, PUNCTUATION);
  296.     psgEnd();
  297.  
  298.     /* rule #5 - get [ART] N */
  299.  
  300.     psgBegin(5);
  301.     psgWord(f_reqId, GET);
  302.     psgWord(f_optType, ARTICLE);
  303.     psgWord(f_reqType, NOUN);
  304.     psgWord(f_optType, PUNCTUATION);
  305.     psgEnd();
  306.  
  307.     /* rule #6 - pick up [ART] N */
  308.  
  309.     psgBegin(6);
  310.     psgWord(f_reqId, PICK);
  311.     psgWord(f_reqId, UP);
  312.     psgWord(f_optType, ARTICLE);
  313.     psgWord(f_reqType, NOUN);
  314.     psgWord(f_optType, PUNCTUATION);
  315.     psgEnd();
  316.  
  317.     /* rule #7 - pick [ART] N up */
  318.  
  319.     psgBegin(7);
  320.     psgWord(f_reqId, PICK);
  321.     psgWord(f_optType, ARTICLE);
  322.     psgWord(f_reqType, NOUN);
  323.     psgWord(f_reqId, UP);
  324.     psgWord(f_optType, PUNCTUATION);
  325.     psgEnd();
  326.  
  327.     /* rule #8 - V */
  328.  
  329.     psgBegin(8);
  330.     psgWord(f_reqType, VERB);
  331.     psgWord(f_optType, PUNCTUATION);
  332.     psgEnd();
  333. corp;
  334.  
  335. /*
  336.  * getObjectC2 - return the C2 for the given object:
  337.  */
  338.  
  339. proc getObjectC2(Id_t id)C2:
  340.  
  341.     case id
  342.     incase SWORD:
  343.     C2('s', 'w')
  344.     incase BOTTLE:
  345.     C2('b', 'o')
  346.     incase KNIFE:
  347.     C2('k', 'n')
  348.     incase PURSE:
  349.     C2('p', 'u')
  350.     incase AMULET:
  351.     C2('a', 'm')
  352.     default:
  353.     C2('?', '?')
  354.     esac
  355. corp;
  356.  
  357. /*
  358.  * carryInit - initialize our list of what we are carrying.
  359.  */
  360.  
  361. proc carryInit()void:
  362.  
  363.     Contents := nil;
  364.     CarryList := nil;
  365.     lAppend(&CarryList, SWORD);
  366.     lAppend(&CarryList, BOTTLE);
  367.     lAppend(&CarryList, KNIFE);
  368.     lAppend(&CarryList, PURSE);
  369.     lAppend(&CarryList, AMULET);
  370. corp;
  371.  
  372. /*
  373.  * carryScan - scanner routine for carry list display.
  374.  */
  375.  
  376. proc carryScan(bool first)*char:
  377.     Id_t id;
  378.  
  379.     if first then
  380.     CarryNext := CarryList;
  381.     fi;
  382.     if CarryNext = nil then
  383.     nil
  384.     else
  385.     id := CarryNext*.il_this;
  386.     CarryNext := CarryNext*.il_next;
  387.     psGet(id)
  388.     fi
  389. corp;
  390.  
  391. /*
  392.  * statInit - initialize and set up our status indicators.
  393.  */
  394.  
  395. proc statInit()void:
  396.  
  397.     PlayerLine := 0;
  398.     PlayerColumn := 0;
  399.     MoveCount := 0;
  400.     Condition := "Healthy";
  401.     scNumber(1, "Line", 1, 1, 4, &PlayerLine);
  402.     scNumber(2, "Column", 1, 13, 4, &PlayerColumn);
  403.     scNumber(3, "Moves", 2, 1, 3, &MoveCount);
  404.     scString(4, "Condition", 2, 13, 10, &Condition);
  405.     scMult(5, "Carrying", 3, 1, 3, carryScan);
  406. corp;
  407.  
  408. /*
  409.  * kindName - turn a word type code into a string for _psDump.
  410.  */
  411.  
  412. proc kindName(Id_t kind)*char:
  413.  
  414.     case kind
  415.     incase VERB:
  416.     "VERB"
  417.     incase ARTICLE:
  418.     "ARTICLE"
  419.     incase ADJECTIVE:
  420.     "ADJECTIVE"
  421.     incase NOUN:
  422.     "NOUN"
  423.     incase PREPOSITION:
  424.     "PREPOSITION"
  425.     incase PUNCTUATION:
  426.     "PUNCTUATION"
  427.     incase AUXILLIARY:
  428.     "AUXILLIARY"
  429.     default:
  430.     "???"
  431.     esac
  432. corp;
  433.  
  434. /*
  435.  * verbOnly - process a verb only input command.
  436.  */
  437.  
  438. proc verbOnly()void:
  439.     extern
  440.     _psDump(channel output text chout;
  441.         proc(Id_t kind)*char kindName)void;
  442.     ulong id;
  443.  
  444.     id := pspWord(1);
  445.     case id
  446.     incase NORTH:
  447.     move(-1, 0);
  448.     scUpdate(1);
  449.     incase SOUTH:
  450.     move(+1, 0);
  451.     scUpdate(1);
  452.     incase EAST:
  453.     move(0, +1);
  454.     scUpdate(2);
  455.     incase WEST:
  456.     move(0, -1);
  457.     scUpdate(2);
  458.     incase QUIT:
  459.     Quit := true;
  460.     incase LONG:
  461.     write(TextOut;
  462. "This is a very long set of output that the program is told to output when "
  463. "you type in the word 'long'.  This output doesn't have a whole lot of "
  464. "significance or intelligence or meaning or whatever, but what the heck, "
  465. "I just wanted to get something that would make more than one line of "
  466. "output go through the TextOut channel to the screen's text area."
  467.     );
  468.     incase DUMP:
  469.     _psDump(TextOut, kindName);
  470.     default:
  471.     write(TextOut; "You must give an object with verb \"",
  472.                psGet(id), "\".");
  473.     esac;
  474. corp;
  475.  
  476. /*
  477.  * drop - drop something.
  478.  */
  479.  
  480. proc drop(uint pos)void:
  481.     Id_t id;
  482.  
  483.     id := pspWord(pos);
  484.     if lIn(CarryList, id) then
  485.     /* player is carrying it, so delete it from the carrying list: */
  486.     lDelete(&CarryList, id);
  487.     /* request that the list on the screen be updated: */
  488.     scUpdate(5);
  489.     /* now we add it to the contents list for this location: */
  490.     lAppend(addContents(PlayerLine, PlayerColumn), id);
  491.     /* now we display the object on the map, but re-move the player on
  492.        top of it so that it is hidden "underneath" the 'me': */
  493.     scNew(id, PlayerLine, PlayerColumn, getObjectC2(id));
  494.     scMove(0, PlayerLine, PlayerColumn);
  495.     write(TextOut; "Dropped.");
  496.     else
  497.     write(TextOut; "You aren't carrying any ", psGet(id), '.');
  498.     fi;
  499. corp;
  500.  
  501. /*
  502.  * get - get something.
  503.  */
  504.  
  505. proc get(uint pos)void:
  506.     *ContentsList_t cl;
  507.     Id_t id;
  508.  
  509.     id := pspWord(pos);
  510.     cl := findCList(PlayerLine, PlayerColumn);
  511.     if lIn(cl*.cl_contents, id) then
  512.     /* the object is here; delete it from that contents, add it to our
  513.        carrying list, and request an update of the list on screen: */
  514.     lDelete(&cl*.cl_contents, id);
  515.     lAppend(&CarryList, id);
  516.     scUpdate(5);
  517.     scDelete(id);
  518.     /* note: we leave the contents list hanging around, but it may get
  519.        used again, and anyway, we'll kill it on termination. */
  520.     write(TextOut; "Taken.");
  521.     else
  522.     write(TextOut; "There is no ", psGet(id), " here.");
  523.     fi;
  524. corp;
  525.  
  526. /*
  527.  * process - process user's commands.
  528.  */
  529.  
  530. proc process()void:
  531.     [79] char buffer;
  532.     *char p;
  533.  
  534.     Quit := false;
  535.     while not Quit do
  536.     scRead(&buffer[0]);
  537.     p := &buffer[0];
  538.     while p* = ' ' or p* = '\t' do
  539.         p := p + 1;
  540.     od;
  541.     if p* ~= '\e' then
  542.         case psParse(&buffer[0])
  543.         incase PS_ERROR:
  544.         write(TextOut; "I don't know the word \"", pspBad(), "\".");
  545.         incase PS_NONE:
  546.         write(TextOut; "I don't understand that sentence.");
  547.         incase 1:
  548.         if not lookAround() then
  549.             write(TextOut; "There is nothing here.");
  550.         fi;
  551.         incase 2:
  552.         incase 4:
  553.         drop(3);
  554.         incase 3:
  555.         drop(4);
  556.         incase 5:
  557.         incase 7:
  558.         get(3);
  559.         incase 6:
  560.         get(4);
  561.         incase 8:
  562.         verbOnly();
  563.         default:
  564.         write(TextOut; "Can't possibly get this!");
  565.         esac;
  566.     fi;
  567.     od;
  568. corp;
  569.  
  570. /*
  571.  * main - main program - the action starts here.
  572.  */
  573.  
  574. proc main()void:
  575.     *byte dummy;
  576.  
  577.     /* set up the various library routine sets: */
  578.     scInit();
  579.     psInit(false);
  580.     lInit();
  581.     /* open a text output channel through the screen output routine: */
  582.     open(TextOut, scPut);
  583.     /* pass a scenery generator and empty object list for map: */
  584.     dummy := scNewMap(scenery, nil);
  585.     /* define the initial viewing window for the map area: */
  586.     scWindow(0, 0);
  587.     /* define the input prompt: */
  588.     scPrompt("> ");
  589.     /* go build our dictionary and grammar: */
  590.     gramInit();
  591.     /* go set up our carrying list: */
  592.     carryInit();
  593.     /* go initialize and set up our status indicators: */
  594.     statInit();
  595.     /* set up the 'objects' in the viewing area: */
  596.     scNew(0,  0,  0, C2('m', 'e'));    /* this is 'us', the key character */
  597.     scNew(1, -2, -2, C2('T', '1'));
  598.     scNew(2, -3, -8, C2('T', '2'));
  599.     scNew(3, -1, +3, C2('T', '3'));
  600.     scNew(4, +3, +2, C2('G', '1'));
  601.     scNew(5, +1, -2, C2('G', '2'));
  602.     /* say hello: */
  603.     write(TextOut;
  604. "     Welcome to the test scenario.  Not much will happen here, but there "
  605. "should be enough for you to get an idea of the kinds of things that can go "
  606. "on. So anyway, here goes:"
  607.     );
  608.     /* go process user's commands: */
  609.     process();
  610.     /* all done, go clean up everything: */
  611.     termContents();
  612.     lFree(CarryList);
  613.     lTerm();
  614.     psTerm();
  615.     scTerm();
  616. corp;
  617.